home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCREEN.SWG / 0082_Sorta good WritePattern.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  3KB  |  73 lines
  1.  
  2. Procedure WriteP (DispStr : String; X,Y,Colr : Byte; FChar : Char;
  3.                   Patrn : String);
  4.  
  5.                (* DispStr   = non-formatted string to be output to the screen.
  6.                               ie: pass '4031234567', not '(403) 123-4567'.
  7.                   X,Y       = location to begin writing string to screen.  If
  8.                               the pattern begins with an 'X', this WILL be
  9.                               taken into account and will advance one space.
  10.                   Colr      = attribute of DispStr.
  11.                   FChar     = Filler character for strings that don't complete
  12.                               the pattern.
  13.                   Patrn     = Template for writing string to screen.
  14.                               Essentially, the only character required in this
  15.                               template is the 'X', to show where a character
  16.                               is NOT displayed.
  17.                *)
  18.  
  19.   (* This procedure will write DispStr to the screen, following the guidelines
  20.      given in Patrn.  For example, calling
  21.  
  22.            WriteP ('40312345',10,11,7,'_','X###XX###X####');
  23.  
  24.      will display:
  25.  
  26.             403  123 45__
  27.            ^advancing space
  28.  
  29.      on the screen.  Of course, the '(   )    -' would make it complete, but
  30.      that's just an example.
  31.   *)
  32.  
  33.   (* Standard disclaimer: I'm not liable for anything this procedure does
  34.                           outside the original purpose of the procedure.  If
  35.                           something bad happens, let me know, but that's all
  36.                           I can do.
  37.   *)
  38.  
  39. Var
  40.    Loc, PX                              : Integer;
  41.  
  42. Begin
  43.      Colr := CheckColor (Colr);
  44.      Loc := ((X-1)*2)+((Y-1)*160);
  45.      Loop := 1;
  46.      PX := 1;
  47.      While PX <= Length (Patrn) Do
  48.      Begin
  49.           If Patrn[PX] = 'X' Then
  50.              While Patrn[PX] = 'X' Do
  51.              Begin
  52.                   Inc (Loc,2);
  53.                   Inc (PX);
  54.              End
  55.           Else
  56.           Begin
  57.                If Loop <= Length (DispStr) Then
  58.                Begin
  59.                     Mem[VidSeg:Loc] := Ord (DispStr[Loop]);
  60.                     Mem[VidSeg:Loc+1] := Colr;
  61.                End
  62.                Else
  63.                Begin
  64.                     Mem[VidSeg:Loc] := Ord (FChar);
  65.                     Mem[VidSeg:Loc+1] := HiColr;
  66.                End;
  67.                Inc (Loop);
  68.                Inc (Loc,2);
  69.                Inc (PX);
  70.           End;
  71.      End;
  72. End;
  73.